home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / tjgold.zip / INSTALL.002 / GOLDREAD.PAS < prev    next >
Pascal/Delphi Source File  |  1995-07-12  |  27KB  |  866 lines
  1. {--------------------------------------------------------------------------}
  2. {                Product: TechnoJock's Turbo Toolkit                       }
  3. {                Version: GOLD                                             }
  4. {                Build:   1.01                                             }
  5. {                                                                          }
  6. {                Copyright 1986-1995  TechnoJock Software, Inc.            }
  7. {                           All Rights Reserved                            }
  8. {                          Restricted by License                           }
  9. {--------------------------------------------------------------------------}
  10.  
  11.                          {************************}
  12.                          {**  Unit:   GOLDREAD  **}
  13.                          {************************}
  14.  
  15. {++++++++++++++++++++++++++++++} unit GOLDREAD; {++++++++++++++++++++++++++++}
  16.  
  17. {$I GOLDFLAG.INC}
  18. {$IFNDEF GoldRead}
  19.    {$DEFINE GoldRead}
  20. {$ENDIF}
  21.  
  22. {++++++++++++++++++++++++++++++++} INTERFACE {+++++++++++++++++++++++++++++++}
  23.  
  24. {Development notes
  25.        1.01a    07/10/95    permitted compilation with TP6
  26. }
  27.  
  28. uses DOS, CRT, GoldAttr, GoldHard, GoldTint, GoldStr, GoldWin, GoldMisc,
  29.      GoldKey, GoldFast, GoldDate, GoldIO, GoldIO2, GoldIO3, GoldReal, GoldDir;
  30.  
  31. const
  32.    MaxScrnFldLen = 30;
  33.  
  34. type
  35.  
  36.    ReadHelpHook = procedure;
  37.  
  38.    ReadSet = record
  39.       LastEcode: integer;
  40.       EMsgFunc: ErrMsgFunc;
  41.       Boundary: gCoords;
  42.       TotWinSpc: byte;
  43.       LastAction: gAction;
  44.       OutsideGap,
  45.       ButtonGap: byte; { area between buttons }
  46.       PromptStyle: byte; { Prompt window style }
  47.       Len: byte;   { length of field }
  48.       ForeGroundByte,
  49.       BackGroundByte: integer;
  50.       FldStrtPos: integer;
  51.       ButStrtPos: integer;
  52.       LabLen: byte;
  53.       TmpPswdStr,
  54.       PromptStrVar: StrScreen;
  55.       PromptNumVar: longint;
  56.       PromptFixedVar,
  57.       PromptRealVar: extended;
  58.       PromptDateVar: Dates;
  59.       PromptRadioVar: byte;
  60.       PromptColorVar: byte;
  61.       Validation: gValidate;
  62.       Password,
  63.       Radio: boolean;
  64.       ReadHelp: ReadhelpHook;
  65.       TextSampleHook: HindHookProc;
  66.       ColorWinDepth: byte;
  67.       Use16BgndColors: boolean;
  68.       FGLabel: string[12];
  69.       BGLabel: string[12];
  70.       FGHotKey: word;
  71.       BGHotKey: word;
  72.       SampleText: string[16];
  73.       SampleTxtHdr: string[14];
  74.       LowerSet: string[100];
  75.       UpperSet: string[100];
  76.       LabelAboveChar: char;
  77.    end;
  78.  
  79. var
  80.    ReadVars: ReadSet;
  81.  
  82. procedure ReadSetError(ECode:integer);
  83. function  LastReadError: integer;
  84. {Prompt Read}
  85. function  PromptStr(X,Y,StrFldLen:byte;Lab,Tit:StrScreen;
  86.                      Default:string;Caps:boolean): string;
  87. function  PromptNum(X,Y:byte;Lab,Tit:StrScreen;
  88.                      Default,Min,Max:LongInt;Spin:boolean): longint;
  89. function  PromptReal(X,Y,FldLen:byte;Lab,Tit:StrScreen;
  90.                      Default,Min,Max:extended): extended;
  91. function  PromptFixedReal(X,Y:byte;Lab,Tit:StrScreen;WLen,DP:byte;
  92.                      Default,Min,Max,Delta:extended;Spin:boolean): extended;
  93. function  PromptDate(X,Y:byte;Lab,Tit:StrScreen;Fmat:gDate;
  94.                      Default,Min,Max:Dates;Spin,Drop:boolean): Dates;
  95. function  PromptRadio(X,Y:byte;Lab,Tit:StrScreen;Fields:string;Default:byte): byte;
  96. function  PromptColor(X,Y,Default:byte;Cmt,Tit:StrScreen): byte;
  97. procedure AssignTextSampleHook(Proc:HindHookProc);
  98. procedure RemoveTextSampleHook;
  99. procedure DefaultTextSample(CurrentField:byte;var Refresh:byte);
  100. procedure AssignReadHelpHook(RFHook: ReadhelpHook);
  101. procedure RemoveReadHelpHook;
  102.  
  103. {+++++++++++++++++++++++++++++} IMPLEMENTATION {+++++++++++++++++++++++++++++}
  104. const
  105.    ReadFormID = 2;
  106.    SpinIconLen = 4;
  107.    DropIconLen = 3;
  108.    RadioIconLen = 5;
  109.    InsideGap = 1;
  110.    MaxRadioElements = 13;
  111.  
  112.                       {******************************}
  113.                       {**  Miscellaneous Routines  **}
  114.                       {******************************}
  115.  
  116. {$IFOPT F-}
  117.    {$DEFINE FOFF}
  118.    {$F+}
  119. {$ENDIF}
  120.  
  121. function ReadEMsg(ECode:integer): string;
  122. {}
  123. begin
  124.    case Ecode of
  125.       0: exit;
  126.       1: ReadEMsg := 'Unable to create Prompt IO form';
  127.       else
  128.          ReadEMsg := 'Internal Read error';
  129.    end; {case}
  130. end; { ReadEMsg }
  131.  
  132. {$IFDEF FOFF}
  133.    {$F-}
  134.    {$UNDEF FOFF}
  135. {$ENDIF}
  136.  
  137. procedure ReadSetError(ECode:integer);
  138. {}
  139. {$IFOPT D+}
  140. var Msg: string;
  141. {$ENDIF}
  142. begin
  143.    ReadVars.LastEcode := ECode;
  144. {$IFOPT D+}  {if debug active display an error message and terminate}
  145.    if Ecode <> 0 then
  146.    begin
  147.       str(Ecode,Msg);
  148.       Msg := Msg+': '+ReadVars.EMsgFunc(Ecode);
  149.       SetWinIgnore(true);
  150.       if PromptCustom(' GoldRead Error ',Msg,' ~I~gnore ',' ~A~bort ','',279,286,0,0, 10000) = 2 then
  151.          Halt;
  152.    end;
  153. {$ENDIF}
  154. end; {ReadSetError}
  155.  
  156. function LastReadError: integer;
  157. {}
  158. begin
  159.    LastReadError := ReadVars.LastECode;
  160. end; { LastReadError }
  161.  
  162. procedure AssignReadHelpHook(RFHook: ReadhelpHook);
  163. {}
  164. begin
  165.    ReadVars.ReadHelp := RFHook;
  166. end; {AssignReadHelpHook }
  167.  
  168. procedure NoReadHelpHook;
  169. begin
  170.    {abstract}
  171. end; { NoReadHelpHook }
  172.  
  173. procedure RemoveReadhelpHook;
  174. {}
  175. begin
  176.    ReadVars.ReadHelp := NoReadHelpHook; {1.01a}
  177. end; { RemoveReadhelpHook }
  178.  
  179. function LineLen(Cmts,Tit:string;FldLen:byte;LabelIncluded:boolean): byte;
  180. {}
  181. var PromptLen, CmtsLen,
  182.     TitLen, TmpLen,
  183.     Border, ButStrLen: byte;
  184. begin
  185.    with ReadVars do
  186.    begin
  187.       CmtsLen := length(Cmts);
  188.       Border := OutsideGap * 2;
  189.       TitLen := Length(Tit) + Border + 2*ord(PromptStyle in [7,8]);
  190.       ButStrLen := length(Strip('A',HiMarker,WinVars.OKbutStr+WinVars.CancelbutStr))
  191.                    + 4 + ButtonGap + Border;
  192.       if @Readhelp <> nil then
  193.          inc(ButStrLen,ButtonGap+length(Strip('A',HiMarker,WinVars.HelpButStr))+2);
  194.       if LabelIncluded then { Label on same line as field }
  195.          PromptLen := InsideGap + CmtsLen + FldLen + Border
  196.       else
  197.          PromptLen := 0;
  198.       TmpLen := GetMax(PromptLen,TitLen);
  199.       TmpLen := GetMax(TmpLen,CmtsLen+Border);
  200.       TmpLen := GetMax(TmpLen,FldLen+Border);
  201.       LineLen := GetMax(TmpLen,ButStrLen);
  202.       {       or the compact way!
  203.       LineLen := GetMax(TmpLen,GetMax(GetMax(LabelLen+Border,FldLen+Border),ButStrLen));
  204.       }
  205.    end;
  206. end; { LineLen }
  207.  
  208. procedure CalcWinCoords(X,Y:byte;FLen,WDep:byte);
  209. {}
  210. begin
  211.    with ReadVars do
  212.    begin
  213.       case PromptStyle of
  214.         0: begin       {no border}
  215.            dec(FLen,2);
  216.            dec(Wdep,2);
  217.         end;
  218.         7,8: inc(Flen,2);
  219.         9: dec(WDep,5);
  220.       end;
  221.       with Boundary do
  222.       begin
  223.          if (X = 0) then  {center window}
  224.          begin
  225.             X1 := pred((HardVars.Width - FLen) div 2);
  226.             X2 := X1 + succ(FLen);
  227.          end else
  228.          begin
  229.             if X + FLen + 2 > HardVars.Width then
  230.             begin
  231.                X1 := HardVars.Width - FLen - 2;
  232.                X2 := HardVars.Width;
  233.             end else
  234.             begin
  235.                X1 := X;
  236.                X2 := X + FLen + 2;
  237.             end;
  238.          end;
  239.          if (Y = 0) then  {center window}
  240.          begin
  241.             Y1 := (HardVars.Depth - WDep) div 2;
  242.             Y2 := Y1 + WDep;
  243.          end else
  244.          begin
  245.             if Y + WDep + 2 > HardVars.Depth then
  246.             begin
  247.                Y1 := HardVars.Depth - WDep - 2;
  248.                Y2 := HardVars.Depth;
  249.             end else
  250.             begin
  251.                Y1 := Y;
  252.                Y2 := Y + WDep;
  253.             end;
  254.          end;
  255.       end;
  256.    end;
  257. end; { CalcWinCoords }
  258.  
  259. procedure CalcGlobals(var FldLen:byte;Lab:StrScreen; LabeltoLeft:boolean);
  260. {}
  261. begin
  262.    with ReadVars do
  263.    begin
  264.       with Boundary do
  265.          TotWinSpc := X2 - succ(X1) - 2*ord(PromptStyle in [7,8]);
  266.       LabLen := length(Lab);
  267.       if Radio then
  268.          with Boundary do
  269.             FldStrtPos := (TotWinSpc div 2) - ((FldLen+RadioIconLen) div 2)
  270.       else
  271.       begin
  272.          if LabelToLeft then
  273.             FldStrtPos := ((TotWinSpc div 2) - ((InsideGap + ord(LabelToLeft)*LabLen + FldLen) div 2))
  274.                            + succ(InsideGap + ord(LabelToLeft)*LabLen)
  275.          else
  276.             FldStrtPos := succ(OutsideGap);
  277.       end;
  278.       ButStrtPos :=ButtonGap + length(Strip('A',HiMarker,WinVars.OKButStr+WinVars.CancelButStr)) + 4;
  279.       if @Readhelp <> nil then
  280.          inc(ButStrtPos,2+ButtonGap+length(Strip('A',HiMarker,WinVars.HelpButStr)));
  281.       {at this point ButStrtPos is the length of all the buttons plus the gaps;
  282.        time to change to the literal start pos of the OK button}
  283.       ButStrtPos := TotWinSpc - pred(ButStrtPos) - Outsidegap;
  284.  
  285.    end;
  286. end; { CalcGlobals }
  287.  
  288. procedure SetPromptColors;
  289. {}
  290. begin
  291.    IOSetColor(IOWinTitle,Tint[PromptTitle]);
  292.    IOSetColor(IOWinBorder1,Tint[PromptBorder1]);
  293.    IOSetColor(IOWinBorder2,Tint[PromptBorder2]);
  294.    IOSetColor(IOWinIcons,Tint[PromptIcons]);
  295.    IOSetColor(IOButtonNorm,Tint[PromptButtonNorm]);
  296.    IOSetColor(IOButtonNormHot,Tint[PromptButtonNormHot]);
  297.    IOSetColor(IOButtonHi,Tint[PromptButtonHi]);
  298.    IOSetColor(IOButtonHiHot,Tint[PromptButtonHiHot]);
  299.    IOSetColor(IOButtonDef,Tint[PromptButtonDef]);
  300.    IOSetColor(IOButtonDefHot,Tint[PromptButtonDefHot]);
  301.    IOSetColor(IOWinBody,Tint[PromptBody]);
  302.    IOSetColor(IOLabelNorm,Tint[PromptBody]);
  303.    IOSetColor(IOLabelHiHot,Tint[PromptBodyHi]);
  304.    IOSetColor(IOLabelHi,Tint[PromptBody]);
  305.    IOSetColor(IOLabelNormHot,Tint[PromptBodyHi]);
  306.    IOSetColor(IOEditNorm,Tint[PromptEditNorm]);
  307.    IOSetColor(IOEditHi,Tint[PromptEditHi]);
  308.    IOSetColor(IOEditErase,Tint[PromptEditErase]);
  309. end; { SetPromptColors }
  310.  
  311. function SetWindow(Tit,Lab:StrScreen; LabelToLeft: boolean): boolean;
  312. {Returns false if function fails}
  313. var
  314.   WinNum: byte;
  315.   BX: byte;
  316. begin
  317.    with ReadVars do
  318.    begin
  319.       Validation := IOVars.DefaultValidate;
  320.       IOVars.DefaultValidate := ValidateAtEnd;
  321.       ActivatePrivateForm;
  322.       SetPromptColors;
  323.       with Boundary do
  324.          SetFormWindow(X1,Y1,X2,Y2,PromptStyle);
  325.       WinNum := FormWinNum;
  326.       if WinNum = 0 then
  327.       begin
  328.          ReadSetError(1);
  329.          exit
  330.       end;
  331.       ActivateWindow(WinNum);
  332.       WinSetTitle(WinNum,Tit);
  333.       WinSetType(WinNum,WMove);
  334.       WinSetShowNum(WinNum,false);
  335.       KwikAddField(1, FldStrtPos,2+ord(not LabelToLeft));
  336.       with Boundary do
  337.          KwikAddField(2, ButStrtPos,(Y2-Y1)-2);
  338.       ButtonDefaultField(2, WinVars.OKButStr,Stop1);
  339.       SetHK(2,WinVars.OKHotKey);
  340.       BX := 2+ButStrtPos + length(strip('A',HiMarker,WinVars.OKButStr)) + ButtonGap;
  341.       with Boundary do
  342.          if @ReadVars.ReadHelp = nil then
  343.             KwikAddLastField(3,BX,(Y2-Y1)-2)
  344.          else
  345.             KwikAddField(3,BX,(Y2-Y1)-2);
  346.       ButtonField(3, WinVars.CancelButStr,Escaped);
  347.       SetHK(3,WinVars.CancelHotKey);
  348.       if @ReadVars.ReadHelp <> nil then
  349.       begin
  350.          inc(BX,2+length(strip('A',HiMarker,WinVars.OKButStr)) + ButtonGap);
  351.          with Boundary do
  352.             KwikAddLastField(4,BX,(Y2-Y1)-2);
  353.          ButtonField(4, WinVars.HelpButStr,Stop9);
  354.          SetHK(4,WinVars.HelpHotKey);
  355.       end;
  356.       FieldRules(1, AllowNull+EraseDefault,[NoChar],[NoChar]);
  357.       if not LabelToLeft then
  358.          SetLabel(1,Labeltop,Labeltop,Lab)
  359.       else
  360.          SetLabel(1,LabelLeft,LabelLeft,Lab);
  361.       SetWindow := true;
  362.    end;
  363. end; { SetWindow }
  364.  
  365.  
  366. function GetLabelLoc(var Lab:string):boolean;
  367. {}
  368. begin
  369.    if (Lab <> '') and (Lab[1] = ReadVars.LabelAboveChar) then
  370.    begin
  371.       GetLabelLoc := false;
  372.       delete(Lab,1,1);
  373.    end
  374.    else
  375.       GetLabelLoc := true;
  376. end; { GetLabelLoc }
  377.  
  378. {$IFOPT F-}
  379.    {$DEFINE FOFF}
  380.    {$F+}
  381. {$ENDIF}
  382. procedure ReadPassword(var K : word; var CurrentField:byte;var Refresh:byte);
  383. {}
  384. begin
  385.    with ReadVars do
  386.    begin
  387.       if (K <> WinVars.OKHotKey) and
  388.          (K <> WinVars.CancelHotKey) and
  389.          (K <> 500) and (K <> 13) and (K <> 271) and (K <> 9) then
  390.       begin
  391.          if IsLetter(K) or IsDigit(K) then
  392.          begin
  393.             TmpPswdStr := TmpPswdStr + WordToChar(K);
  394.             K := MaskChr;
  395.          end
  396.          else if K = 8 then
  397.             delete(TmpPswdStr,length(TmpPswdStr),1)
  398.          else
  399.             K := 0;
  400.          Refresh := RefreshCurrent;
  401.       end;
  402.    end;
  403. end; { ReadPassword }
  404. {$IFDEF FOFF}
  405.    {$F-}
  406.    {$UNDEF FOFF}
  407. {$ENDIF}
  408.  
  409. function PromptStr(X,Y,StrFldLen:byte;Lab,Tit:StrScreen;
  410.                      Default:string;Caps:boolean): string;
  411. {}
  412. var Action: gAction;
  413.     FmtCh: char;
  414.     TmpFldLen: byte;
  415.     LabelToLeft,
  416.     OverRide: boolean;
  417. begin
  418.    with ReadVars do
  419.    begin
  420.       LastAction := None;
  421.       PromptStrVar := Default;
  422.       OverRide := (StrFldLen > MaxScrnFldLen);
  423.       if OverRide then
  424.       begin
  425.          TmpFldLen := StrFldLen;
  426.          StrFldLen := MaxScrnFldLen;
  427.       end;
  428.       LabelToLeft := GetLabelLoc(Lab);
  429.       CalcWinCoords(X,Y,LineLen(Lab,Tit,StrFldLen,LabelToLeft),6+ord(not LabelToLeft));
  430.       CalcGlobals(StrFldLen,Lab,LabelToLeft);
  431.       if not OverRide and Caps then
  432.          FmtCh := '!'  { set to uppercase }
  433.       else
  434.          FmtCh := '*';
  435.       if SetWindow(Tit,Lab,LabelToLeft) then
  436.       begin
  437.          if OverRide then
  438.             ScrollField(1, PromptStrVar,MaxScrnFldLen,TmpFldLen)
  439.          else
  440.             StringField(1,PromptStrVar,Replicate(StrFldLen,FmtCh));
  441.          if Password then
  442.             AssignCharHook(ReadPassword);
  443.          repeat
  444.             LastAction := EditForm(1);
  445.             if LastAction = Stop9 then
  446.                ReadVars.ReadHelp;
  447.          until LastAction in [Stop1,Finished,Escaped];
  448.          if LastAction = Stop1 then
  449.             if Password then
  450.                if Caps then
  451.                   PromptStr := SetUpper(TmpPswdStr)
  452.                else
  453.                   PromptStr := TmpPswdStr
  454.             else
  455.                PromptStr := PromptStrVar
  456.          else
  457.             PromptStr := Default;
  458.          DisposeFields;
  459.          DisposePrivateForm;
  460.          IOVars.DefaultValidate := Validation;
  461.          Password := false;
  462.       end;
  463.    end;
  464. end; { PromptStr }
  465.  
  466. function  PromptNum(X,Y:byte;Lab,Tit:StrScreen;
  467.                      Default,Min,Max:LongInt;Spin:boolean): longint;
  468. {valid values are -2147483648..2147483647}
  469. var MinLen, MaxLen,
  470.     TmpLen, NumFldLen: byte;
  471.     FmtCh: char;
  472.     LabelToLeft: boolean;
  473. begin
  474.    with ReadVars do
  475.    begin
  476.       LastAction := none;
  477.       PromptNumVar := Default;
  478.       if (Min = 0) and (Max = 0) then
  479.          NumFldLen := length(IntToStr(MaxLongInt))
  480.       else
  481.       begin
  482.          MinLen := length(IntToStr(Min));
  483.          MaxLen := length(IntToStr(Max));
  484.          if MaxLen >= MinLen then
  485.             NumFldLen := MaxLen
  486.          else
  487.             NumFldLen := MinLen;
  488.       end;
  489.       if Spin then
  490.          NumFldLen := NumFldLen + SpinIconLen;
  491.       LabelToLeft := GetLabelLoc(Lab);
  492.       CalcWinCoords(X,Y,LineLen(Lab,Tit,NumFldLen,LabelToLeft),6+ord(not LabelToLeft));
  493.       CalcGlobals(NumFldLen,Lab,LabelToLeft);
  494.       FmtCh := '#';
  495.       if SetWindow(Tit,Lab,LabelToLeft) then
  496.       begin
  497.          if Spin then
  498.             SpinLongField(1, PromptNumVar, NumFldLen - SpinIconLen,Min,Max,1)
  499.          else
  500.             LongIntField(1,PromptNumVar,Replicate(NumFldLen,FmtCh),Min,Max);
  501.          repeat
  502.             LastAction := EditForm(1);
  503.             if LastAction = Stop9 then
  504.                ReadVars.ReadHelp;
  505.          until LastAction in [Stop1,Finished,Escaped];
  506.          if LastAction = Stop1 then
  507.             PromptNum := PromptNumVar
  508.          else
  509.             PromptNum := Default;
  510.          DisposeFields;
  511.          DisposePrivateForm;
  512.          IOVars.DefaultValidate := Validation;
  513.       end;
  514.    end;
  515. end; { PromptNum }
  516.  
  517. function  PromptReal(X,Y,FldLen:byte;Lab,Tit:StrScreen;
  518.                      Default,Min,Max:extended): extended;
  519. {}
  520. var RealFldLen: byte;
  521.     FmtCh: char;
  522.     LabelToLeft: boolean;
  523. begin
  524.    with ReadVars do
  525.    begin
  526.       LastAction := none;
  527.       PromptRealVar := Default;
  528.       RealFldLen := FldLen;
  529.       LabelToLeft := GetLabelLoc(Lab);
  530.       CalcWinCoords(X,Y,LineLen(Lab,Tit,RealFldLen,LabelToLeft),6+ord(not LabelToLeft));
  531.       CalcGlobals(RealFldLen,Lab,LabelToLeft);
  532.       FmtCh := '#';
  533.       if SetWindow(Tit,Lab,LabelToLeft) then
  534.       begin
  535.          RealField(1,PromptRealVar,Replicate(RealFldLen,FmtCh),Min,Max);
  536.          repeat
  537.             LastAction := EditForm(1);
  538.             if LastAction = Stop9 then
  539.                ReadVars.ReadHelp;
  540.          until LastAction in [Stop1,Finished,Escaped];
  541.          if LastAction = Stop1 then
  542.             PromptReal := PromptRealVar
  543.          else
  544.             PromptReal := Default;
  545.          DisposeFields;
  546.          DisposePrivateForm;
  547.          IOVars.DefaultValidate := Validation;
  548.       end;
  549.    end;
  550. end; { PromptReal }
  551.  
  552. function  PromptFixedReal(X,Y:byte;Lab,Tit:StrScreen;WLen,DP:byte;
  553.                      Default,Min,Max,Delta:extended;Spin:boolean): extended;
  554. {}
  555. var FxdFldLen: byte;
  556.     LabelToLeft: boolean;
  557. begin
  558.    with ReadVars do
  559.    begin
  560.       LastAction := none;
  561.       PromptFixedVar := Default;
  562.       if DP = 0 then
  563.          FxdFldLen := WLen
  564.       else
  565.          FxdFldLen := WLen + succ(DP);
  566.       if Spin then
  567.          FxdFldLen := FxdFldLen + SpinIconLen;
  568.       LabelToLeft := GetLabelLoc(Lab);
  569.       CalcWinCoords(X,Y,LineLen(Lab,Tit,FxdFldLen,LabelToLeft),6+ord(not LabelToLeft));
  570.       CalcGlobals(FxdFldLen,Lab,LabelToLeft);
  571.       if SetWindow(Tit,Lab,LabelToleft) then
  572.       begin
  573.          if Spin then
  574.             SpinRealField(1,PromptFixedVar,WLen,DP,Min,Max,Delta)
  575.          else
  576.             FixedRealField(1,PromptFixedVar,WLen,DP,Min,Max);
  577.          repeat
  578.             LastAction := EditForm(1);
  579.             if LastAction = Stop9 then
  580.                ReadVars.ReadHelp;
  581.          until LastAction in [Stop1,Finished,Escaped];
  582.          if LastAction = Stop1 then
  583.             PromptFixedReal := PromptFixedVar
  584.          else
  585.             PromptFixedReal := Default;
  586.          DisposeFields;
  587.          DisposePrivateForm;
  588.          IOVars.DefaultValidate := Validation;
  589.       end;
  590.    end;
  591. end; { PromptFixedReal }
  592.  
  593. function  PromptDate(X,Y:byte;Lab,Tit:StrScreen;Fmat:gDate;
  594.                      Default,Min,Max:Dates;Spin,Drop:boolean): Dates;
  595. {}
  596. var DatFldLen: byte;
  597.     LabelToLeft: boolean;
  598. begin
  599.    with ReadVars do
  600.    begin
  601.       LastAction := none;
  602.       PromptDateVar := Default;
  603.       if Spin then
  604.          DatFldLen := 12;
  605.       if Drop then
  606.          DatFldLen := 11;
  607.       if Spin and Drop then
  608.          DatFldLen := 13;
  609.       LabelToLeft := GetLabelLoc(Lab);
  610.       CalcWinCoords(X,Y,LineLen(Lab,Tit,DatFldLen,LabelToLeft),6+ord(not LabelToLeft));
  611.       CalcGlobals(DatFldLen,Lab,LabelToLeft);
  612.       if SetWindow(Tit,Lab,LabelToLeft) then
  613.       begin
  614.          if Spin and Drop then
  615.             SpinDropDateField(1, PromptDateVar, Fmat,'',Min,Max)
  616.          else if Drop then
  617.             DropDateField(1, PromptDateVar, Fmat,'',Min,Max)
  618.          else if Spin then
  619.             SpinDateField(1, PromptDateVar, Fmat,'',Min,Max)
  620.          else DateField(1, PromptDateVar, Fmat, '', Min,Max);
  621.          repeat
  622.             LastAction := EditForm(1);
  623.             if LastAction = Stop9 then
  624.                ReadVars.ReadHelp;
  625.          until LastAction in [Stop1,Finished,Escaped];
  626.          if LastAction = Stop1 then
  627.             PromptDate := PromptDateVar
  628.          else
  629.             PromptDate := Default;
  630.          DisposeFields;
  631.          DisposePrivateForm;
  632.          IOVars.DefaultValidate := Validation;
  633.       end;
  634.    end;
  635. end; { PromptDate }
  636.  
  637. function PromptRadio(X,Y:byte;Lab,Tit:StrScreen;Fields:string;Default:byte): byte;
  638. {NOTES:  The Fields parameter is a string of element names.
  639.          Each element is separated by a split bar (|).
  640.          The Default parameter is the beginning element.    }
  641. var RadFldLen,
  642.     ElementCount, I: byte;
  643.     ElementStr: StrScreen;
  644.  
  645.    function GetElement: StrScreen;
  646.    {}
  647.    begin
  648.       if (pos(StrVars.LineBreak,Fields) = 0) then
  649.          GetElement := copy(Fields,1,length(Fields))
  650.       else
  651.          GetElement := copy(Fields,1,pred(pos(StrVars.LineBreak,Fields)));
  652.       delete(Fields,1,pos(StrVars.LineBreak,Fields));
  653.    end;
  654.  
  655. begin
  656.    with ReadVars do
  657.    begin
  658.       LastAction := none;
  659.       Radio := true;
  660.       RadFldLen := WidestLine(Fields);
  661.       ElementCount := succ(CharCount(StrVars.LineBreak,Fields));
  662.       if ElementCount > MaxRadioElements then
  663.          ElementCount := MaxRadioElements;
  664.       CalcWinCoords(X,Y,LineLen(Lab,Tit,RadFldLen,false)+RadioIconLen,ElementCount+6);
  665.       CalcGlobals(RadFldLen,Lab,false);
  666.       if SetWindow(Tit,Lab,false) then
  667.       begin
  668.          PromptRadioVar := Default;
  669.          RadioField(1,succ(RadFldLen+RadioIconLen),ElementCount,PromptRadioVar);
  670.          for I := 1 to ElementCount do
  671.              RadioAddItem(1, 1,I,GetElement,'',0);
  672.          repeat
  673.             LastAction := EditForm(1);
  674.             if LastAction = Stop9 then
  675.                ReadVars.ReadHelp;
  676.          until LastAction in [Stop1,Finished,Escaped];
  677.          if LastAction = Stop1 then
  678.             PromptRadio := PromptRadioVar
  679.          else
  680.             PromptRadio := Default;
  681.          DisposeFields;
  682.          DisposePrivateForm;
  683.          IOVars.DefaultValidate := Validation;
  684.       end;
  685.       Radio := false;
  686.    end;
  687. end; { PromptRadio }
  688.  
  689. procedure AssignTextSampleHook(Proc:HindHookProc);
  690. {}
  691. begin
  692.    ReadVars.TextSampleHook := Proc;
  693. end; { AssignTextSampleHook }
  694.  
  695. procedure RemoveTextSampleHook;
  696. {}
  697. begin
  698.    ReadVars.TextSampleHook := DefaultTextSample;
  699. end; { RemoveTextSampleHook }
  700.  
  701. function ColorSet(BothSets:boolean): string;
  702. {}
  703. begin
  704.    if BothSets then
  705.       ColorSet := ReadVars.LowerSet+'|'+ReadVars.UpperSet
  706.    else
  707.       ColorSet := ReadVars.LowerSet;
  708. end; { ColorSet }
  709.  
  710.  
  711. {$IFOPT F-}
  712.    {$DEFINE FOFF}
  713.    {$F+}
  714. {$ENDIF}
  715.  
  716. procedure DefaultTextSample(CurrentField:byte;var Refresh:byte);
  717. {}
  718. var A: byte;
  719. begin
  720.    with ReadVars do
  721.    begin
  722.       Refresh := RefreshOthers;
  723.       A := Cattr(pred(ForeGroundByte),pred(BackGroundByte));
  724.       WriteAT(succ(OutsideGap),8,Tint[PromptBody],SampleTxtHdr);
  725.       WriteAT(succ(OutsideGap),9,A,SampleText);
  726.       WriteAT(succ(OutsideGap),10,A,SampleText);
  727.    end;
  728. end; { DefaultTextSample }
  729.  
  730. {$IFDEF FOFF}
  731.    {$F-}
  732.    {$UNDEF FOFF}
  733. {$ENDIF}
  734.  
  735. function PromptColor(X,Y,Default:byte;Cmt,Tit:StrScreen): byte;
  736. {}
  737. var FldStrtPos,
  738.     ColorFldLen : byte;
  739.     WinNum: integer;
  740.     CmtVar: string[40];
  741. begin
  742.    with ReadVars do
  743.    begin
  744.       LastAction := None;
  745.       ColorFldLen := 29 + length(strip('A',HiMarker,WinVars.OKButStr)) + (OutsideGap*2) + ButtonGap;
  746.       ForeGroundbyte := succ(Fattr(Default));
  747.       BackGroundbyte := succ(Battr(Default));
  748.       if ColorWinDepth > 22 then
  749.          ColorWinDepth := 22;
  750.       CalcWinCoords(X,Y,LineLen(Cmt,Tit,ColorFldLen,false),ColorWinDepth);
  751.       CalcGlobals(ColorFldLen,Cmt,true);
  752.       Validation := IOVars.DefaultValidate;
  753.       IOVars.DefaultValidate := ValidateAtEnd;
  754.       ActivatePrivateForm;
  755.       SetPromptColors;
  756.       with Boundary do
  757.          SetFormWindow(X1,Y1,X2,Y2,PromptStyle);
  758.       WinNum := FormWinNum;
  759.       if WinNum = 0 then
  760.       begin
  761.          DisposePrivateForm;
  762.          ReadSetError(1);
  763.          exit
  764.       end;
  765.       ActivateWindow(WinNum);
  766.       WinSetTitle(WinNum,Tit);
  767.       WinSetType(WinNum,WMoveNoClose);
  768.       WinSetShowNum(WinNum,false);
  769.       WinDisplay(WinNum);
  770.       if Cmt <> '' then
  771.          WriteHi(succ(OutsideGap),2,Tint[PromptBodyHi],Tint[PromptBody],Cmt);
  772.       AssignHindHook(ReadVars.TextSampleHook);
  773.       FldStrtPos := ((TotWinSpc div 2) - (ColorFldLen div 2));
  774.       KwikAddField(1, 12+OutsideGap,4);      { foreground }
  775.       KwikAddField(2, 12+OutsideGap,6);      { background }
  776.       KwikAddField(3, 35,4);      { OK button }
  777.       if @ReadHelp = nil then
  778.          KwikAddLastField(4, 35,6)  { Cancel Button }
  779.       else
  780.       begin
  781.          KwikAddField(4, 35,6);
  782.          KwikAddLastField(5, 35,8);
  783.       end;
  784.       SpinDropListField(1,12,ForeGroundByte);
  785.       SetLabel(1,LabelLeft,LabelLeft,FGLabel);
  786.       SetHK(1,FGHotKey);
  787.       ListKwikAddItem(1,LowerSet+'|'+UpperSet);
  788.       SpinDropListField(2,12,BackGroundByte);
  789.       SetLabel(2,LabelLeft,LabelLeft,BGLabel);
  790.       SetHK(2,BGHotKey);
  791.       ListKwikAddItem(2,ColorSet(Use16BgndColors));
  792.       ButtonDefaultField(3, WinVars.OKButStr,Stop1);
  793.       SetHK(3,WinVars.OKHotKey);
  794.       ButtonField(4, WinVars.CancelButStr,Escaped);
  795.       SetHK(4, WinVars.CancelHotKey);
  796.       if @ReadHelp <> nil then
  797.       begin
  798.          ButtonField(5, WinVars.HelpButStr,Stop9);
  799.          SetHK(5, WinVars.HelpHotKey);
  800.       end;
  801.       repeat
  802.          LastAction := EditForm(1);
  803.          if LastAction = Stop9 then
  804.             ReadVars.ReadHelp;
  805.       until LastAction in [Stop1,Finished,Escaped];
  806.       if LastAction = Stop1 then
  807.          PromptColor := Cattr(pred(ForeGroundByte),pred(BackGroundByte))
  808.       else
  809.          PromptColor := Default;
  810.       DisposeFields;
  811.       DisposePrivateForm;
  812.    end;
  813. end; { PromptColor }
  814.  
  815.               {*********************************************}
  816.               {**  U N I T   I N I T I A L I Z A T I O N  **}
  817.               {*********************************************}
  818.  
  819. procedure ReadDefaultSettings;
  820. {}
  821. begin
  822.    with ReadVars do
  823.    begin
  824.       PromptStyle := WinVars.PromptStyle;
  825.       Use16BgndColors := false;
  826.       FGLabel := '~F~oreground';
  827.       BGLabel := '~B~ackground';
  828.       FGHotKey := 289;          { Alt+F }
  829.       BGHotKey := 304;          { Alt+B }
  830.       SampleText := ' Text Text Text ';
  831.       SampleTxtHdr := 'Sample Text';
  832.       LowerSet := 'Black|Blue|Green|Cyan|Red|Magenta|Brown|LightGray';
  833.       UpperSet := 'DarkGray|LightBlue|LightGreen|LightCyan|LightRed|LightMagenta|Yellow|White';
  834.       OutsideGap := 2;
  835.       ButtonGap := 2;
  836.       Password := false;
  837.       TextSampleHook := DefaultTextSample;
  838.       ColorWinDepth := 12;
  839.       LabelAboveChar := '^';
  840.    end;
  841. end; { ReadDefaultSettings }
  842.  
  843. procedure GoldReadInit;
  844. {}
  845. begin
  846.    with ReadVars do
  847.    begin
  848.       EMsgFunc := ReadEMsg;
  849.       ReadHelp := NoReadHelpHook;
  850.       with Boundary do
  851.       begin
  852.          X1 := 0;
  853.          Y1 := 0;
  854.          X2 := 0;
  855.          Y2 := 0;
  856.       end;
  857.       TmpPswdStr := '';
  858.       Radio := false;
  859.    end;
  860.    ReadDefaultSettings;
  861. end; {GoldReadInit}
  862.  
  863. begin
  864.    GoldReadInit;
  865. end.
  866.